home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / erf.arc / ERFT1.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-08-12  |  2.5 KB  |  96 lines
  1. program ERFT1(data, out);
  2.  
  3.    {ERFT1.PAS #2.00 85-08-06 STANDARD ERROR FUNCTION TEST & DEMONSTRATION
  4.  
  5.               V02 L00 derived 85-08-06 by Dennis E. Hamilton for testing
  6.                       of Turbo Pascal version, ERF.PLB.
  7.  
  8.               V01 L02 completed on 79-03-22 by DEH for verifying erf(x)
  9.                       and PN(x) using Benton Harbor Basic #5.01.01.      }
  10.  
  11.  
  12. var
  13.  
  14.    data: text {source of test input values};
  15.  
  16.     out: text {presentation of the test results};
  17.  
  18.       z: real {test value from data };
  19.      ez: real {known value for erf(z) to be checked};
  20.  
  21.  
  22. {$I ERF.PLB } {Vintage 2.00 definition for erf(x) }
  23.  
  24. procedure
  25.  
  26.    commentary;
  27.  
  28.    var    c: char;
  29.        line: string[255];
  30.  
  31.    begin {transfer comment lines (" in column 1) from the input data to the
  32.           output report until non-comment lines are produced.}
  33.  
  34.    read(data, c);
  35.    
  36.    while (c = '"') or (c = '/')
  37.       do begin
  38.          if c = '/'
  39.          then begin
  40.               writeln;
  41.               write('ERFT1> Press any key to continue: ');
  42.               read(KBD, c);
  43.               ClrScr;
  44.               writeln('ERFT1> #2.00 85-08-06 STANDARD ERROR FUNCTION TEST',
  45.                               ' & DEMONSTRATION');
  46.               writeln;
  47.               end;
  48.          c := ' ';
  49.             {replacing the " by blank to indicate already noticed}
  50.          readln(data, line);
  51.          writeln(out, line);
  52.          if not eof(data)
  53.          then read(data, c);
  54.          end;
  55.    end {commentary};
  56.  
  57. BEGIN {ERFT1.PAS}
  58. CrtInit;
  59.  
  60. assign(out, 'CON:');  {or a filename for capturing the test report}
  61. rewrite(out);
  62.  
  63. writeln(out, 'ERFT1> #2.00 85-08-06 STANDARD ERROR FUNCTION TEST',
  64.                      ' & DEMONSTRATION');
  65. writeln(out);
  66.  
  67. assign(data, 'ERFT1.DAT');
  68. reset(data);  {preparing to access the test data file.}
  69.  
  70. while not EOF(data)
  71.    do begin
  72.       commentary;
  73.       if not EOF(data)
  74.       then begin
  75.            readln(data, z, ez); {test value and the expected value}
  76.            write(out, '       ');
  77.            if (abs(z) < 1.0E-8) or (abs(z) >= 10.0)
  78.            then write(out, z :15)
  79.            else write(out, z :11:9, '    ');
  80.            write(out, '   ');
  81.            if abs(erf(z)) < 1.0E-8
  82.            then write(out, erf(z) :16)
  83.            else write(out, erf(z) :13:11, '   ');
  84.            writeln(out, '      ', abs(erf(z)-ez) :8);
  85.            end;
  86.       end;
  87.  
  88. writeln(out);
  89.  
  90. close(data);
  91. close(out);
  92.  
  93. CrtExit;
  94. END. {ERFT1}
  95.  
  96.